home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xlisp20 / xlisp_c / xldbug.c < prev    next >
Text File  |  1990-02-03  |  4KB  |  193 lines
  1. /* xldebug - xlisp debugging support */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern long total;
  10. extern int xldebug;
  11. extern int xltrace;
  12. extern NODE *s_unbound;
  13. extern NODE *s_stdin,*s_stdout;
  14. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  15. extern NODE *xlstack;
  16. extern NODE *true;
  17. extern NODE **trace_stack;
  18. extern char buf[];
  19.  
  20. /* external routines */
  21. extern char *malloc();
  22.  
  23. /* forward declarations */
  24. FORWARD NODE *stacktop();
  25.  
  26. /* xlfail - xlisp error handler */
  27. xlfail(emsg)
  28.   char *emsg;
  29. {
  30.     xlerror(emsg,stacktop());
  31. }
  32.  
  33. /* xlabort - xlisp serious error handler */
  34. xlabort(emsg)
  35.   char *emsg;
  36. {
  37.     xlsignal(emsg,s_unbound);
  38. }
  39.  
  40. /* xlbreak - enter a break loop */
  41. xlbreak(emsg,arg)
  42.   char *emsg; NODE *arg;
  43. {
  44.     breakloop("break",NULL,emsg,arg,TRUE);
  45. }
  46.  
  47. /* xlerror - handle a fatal error */
  48. xlerror(emsg,arg)
  49.   char *emsg; NODE *arg;
  50. {
  51.     doerror(NULL,emsg,arg,FALSE);
  52. }
  53.  
  54. /* xlcerror - handle a recoverable error */
  55. xlcerror(cmsg,emsg,arg)
  56.   char *cmsg,*emsg; NODE *arg;
  57. {
  58.     doerror(cmsg,emsg,arg,TRUE);
  59. }
  60.  
  61. /* xlerrprint - print an error message */
  62. xlerrprint(hdr,cmsg,emsg,arg)
  63.   char *hdr,*cmsg,*emsg; NODE *arg;
  64. {
  65.     sprintf(buf,"%s: %s",hdr,emsg); stdputstr(buf);
  66.     if (arg != s_unbound) { stdputstr(" - "); stdprint(arg); }
  67.     else xlterpri(s_stdout->n_symvalue);
  68.     if (cmsg) { sprintf(buf,"if continued: %s\n",cmsg); stdputstr(buf); }
  69. }
  70.  
  71. /* doerror - handle xlisp errors */
  72. LOCAL doerror(cmsg,emsg,arg,cflag)
  73.   char *cmsg,*emsg; NODE *arg; int cflag;
  74. {
  75.     /* make sure the break loop is enabled */
  76.     if (getvalue(s_breakenable) == NIL)
  77.     xlsignal(emsg,arg);
  78.  
  79.     /* call the debug read-eval-print loop */
  80.     breakloop("error",cmsg,emsg,arg,cflag);
  81. }
  82.  
  83. /* breakloop - the debug read-eval-print loop */
  84. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  85.   char *hdr,*cmsg,*emsg; NODE *arg; int cflag;
  86. {
  87.     NODE *oldstk,expr,*val;
  88.     CONTEXT cntxt;
  89.     int type;
  90.  
  91.     /* print the error message */
  92.     xlerrprint(hdr,cmsg,emsg,arg);
  93.  
  94.     /* flush the input buffer */
  95.     xlflush();
  96.  
  97.     /* do the back trace */
  98.     if (getvalue(s_tracenable)) {
  99.     val = getvalue(s_tlimit);
  100.     xlbaktrace(fixp(val) ? (int)val->n_int : -1);
  101.     }
  102.  
  103.     /* create a new stack frame */
  104.     oldstk = xlsave(&expr,NULL);
  105.  
  106.     /* increment the debug level */
  107.     xldebug++;
  108.  
  109.     /* debug command processing loop */
  110.     xlbegin(&cntxt,CF_ERROR|CF_CLEANUP|CF_CONTINUE,true);
  111.     for (type = 0; type == 0; ) {
  112.  
  113.     /* setup the continue trap */
  114.     if (type = setjmp(cntxt.c_jmpbuf))
  115.         switch (type) {
  116.         case CF_ERROR:
  117.             xlflush();
  118.             type = 0;
  119.             continue;
  120.         case CF_CLEANUP:
  121.             continue;
  122.         case CF_CONTINUE:
  123.             if (cflag) continue;
  124.             else xlabort("this error can't be continued");
  125.         }
  126.  
  127.     /* read an expression and check for eof */
  128.     if (!xlread(getvalue(s_stdin),&expr.n_ptr)) {
  129.         type = CF_CLEANUP;
  130.         break;
  131.     }
  132.  
  133.     /* evaluate the expression */
  134.     expr.n_ptr = xleval(expr.n_ptr);
  135.  
  136.     /* print it */
  137.     xlprint(getvalue(s_stdout),expr.n_ptr,TRUE);
  138.     xlterpri(getvalue(s_stdout));
  139.     }
  140.     xlend(&cntxt);
  141.  
  142.     /* decrement the debug level */
  143.     xldebug--;
  144.  
  145.     /* restore the previous stack frame */
  146.     xlstack = oldstk;
  147.  
  148.     /* continue the next higher break loop on clean-up */
  149.     if (type == CF_CLEANUP)
  150.     xlsignal("quit from break loop",s_unbound);
  151. }
  152.  
  153. /* tpush - add an entry to the trace stack */
  154. xltpush(nptr)
  155.     NODE *nptr;
  156. {
  157.     if (++xltrace < TDEPTH)
  158.     trace_stack[xltrace] = nptr;
  159. }
  160.  
  161. /* tpop - pop an entry from the trace stack */
  162. xltpop()
  163. {
  164.     xltrace--;
  165. }
  166.  
  167. /* stacktop - return the top node on the stack */
  168. LOCAL NODE *stacktop()
  169. {
  170.     return (xltrace >= 0 && xltrace < TDEPTH ? trace_stack[xltrace] : s_unbound);
  171. }
  172.  
  173. /* baktrace - do a back trace */
  174. xlbaktrace(n)
  175.   int n;
  176. {
  177.     int i;
  178.  
  179.     for (i = xltrace; (n < 0 || n--) && i >= 0; i--)
  180.     if (i < TDEPTH)
  181.         stdprint(trace_stack[i]);
  182. }
  183.  
  184. /* xldinit - debug initialization routine */
  185. xldinit()
  186. {
  187.     if ((trace_stack = (NODE **) malloc(TSTKSIZE)) == NULL)
  188.     xlabort("insufficient memory");
  189.     total += (long) TSTKSIZE;
  190.     xltrace = -1;
  191.     xldebug = 0;
  192. }
  193. əəəəəəəəə